home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / spell / spell.bas < prev    next >
Encoding:
BASIC Source File  |  1994-09-15  |  5.5 KB  |  222 lines
  1. 'used to figure out if it was a text box control passed to the function
  2. Declare Function GetClassName Lib "User" (ByVal hWnd As Integer, ByVal lpClassName As String, ByVal nMaxCount As Integer) As Integer
  3. 'used to create a temporary text file that can be opened in our Excel object
  4. Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer, ByVal lpPrefixString As String, ByVal wUnique As Integer, ByVal lpTempFileName As String) As Integer
  5.  
  6. 'the class type of a VB Text Box
  7. Global Const TEXT_BOX = "ThunderTextBox"
  8.  
  9. 'the Excel object type
  10. Global Const EXCEL_OBJECT = "EXCEL.APPLICATION"
  11.  
  12. Function FixText (MyText As String) As String
  13.  
  14. Dim StartPos As Integer
  15. Dim FoundPos As Integer
  16.  
  17. 'get rid of the tab characters
  18. StartPos = 1
  19. FoundPos = InStr(StartPos, MyText, Chr$(9))
  20.  
  21. While FoundPos > 0
  22.   Mid$(MyText, FoundPos, 1) = Chr$(32)
  23.   StartPos = FoundPos + 1
  24.   FoundPos = InStr(StartPos, MyText, Chr$(9))
  25. Wend
  26.  
  27. 'put the comma's back in
  28. StartPos = 1
  29. FoundPos = InStr(StartPos, MyText, Chr$(186))
  30.  
  31. While FoundPos > 0
  32.   Mid$(MyText, FoundPos, 2) = Chr$(44)
  33.   StartPos = FoundPos + 1
  34.   FoundPos = InStr(StartPos, MyText, Chr$(186))
  35. Wend
  36.  
  37. FixText = MyText
  38.  
  39. End Function
  40.  
  41. Function GetTempFile () As String
  42.  
  43. Dim FileName As String
  44. Dim RetVal As Integer
  45.  
  46. 'clear out the variable
  47. FileName = String$(256, 0)
  48.  
  49. 'get a temporary file name
  50. RetVal = GetTempFileName(0, "", 0, FileName)
  51.  
  52. 'trim out the blanks
  53. FileName = Left$(FileName, RetVal)
  54.  
  55. 'return the results
  56. GetTempFile = FileName
  57.  
  58. End Function
  59.  
  60. Function PrepText (MyText As String) As String
  61.  
  62. 'this function is necessary to remove the commas from the text.  We need to do so
  63. 'because when Excel saves the file back to text, it will put quotes around any
  64. 'word that has a comma following it.  So, we're taking a chance and saying that we
  65. 'don't think anyone is going to use ANSI character #186 in any of the text we're
  66. 'checking.  If it is in there, it will be changed to a comma when it comes back
  67. '(in the FixText function).
  68.  
  69. Dim StartPos As Integer
  70. Dim FoundPos As Integer
  71.  
  72. StartPos = 1
  73. FoundPos = InStr(StartPos, MyText, Chr$(44))
  74.  
  75. While FoundPos > 0
  76.   Mid$(MyText, FoundPos, 1) = Chr$(186)
  77.   StartPos = FoundPos + 1
  78.   FoundPos = InStr(StartPos, MyText, Chr$(44))
  79. Wend
  80.  
  81. PrepText = MyText
  82.  
  83. End Function
  84.  
  85. Function SpellCheck (MyControl As Control) As Integer
  86.  
  87. Dim ClassName As String
  88. Dim RetVal As Integer
  89. Dim xlApp As Object
  90. Dim xlWorkBook As Object
  91. Dim xlWorkSheet As Object
  92. Dim FileName As String
  93. Dim FileName2 As String
  94. Dim MyText As String
  95. Dim FileNum As Integer
  96.  
  97. Const xlTextPrinter = 36
  98. Const xlWindows = 2
  99. Const xlDelimited = 1
  100. Const xlNone = -4142
  101. Const xlText = -4158
  102. Const xlTextWindows = 20
  103.  
  104. On Error GoTo SpellCheckError
  105.  
  106. SpellCheck = False  'set initial value
  107.  
  108. 'clear out variable
  109. ClassName = String$(256, 0)
  110.  
  111. 'get the class name of the control to make sure that it's a VB Text Box
  112. RetVal = GetClassName(MyControl.hWnd, ClassName, 255)
  113.  
  114. ClassName = Left$(ClassName, RetVal)
  115.  
  116. If ClassName <> TEXT_BOX Then  'if we haven't been passed a text box as a control
  117.   MsgBox "The control you are checking is not a text box; the spell check will not work.", 16, ProgTitle
  118.   Exit Function
  119. End If
  120.  
  121. 'turn the pointer to an hourglass
  122. Screen.MousePointer = 11
  123.  
  124. 'put the text into a variable
  125. MyText = MyControl.Text
  126.  
  127. 'change out all the commas because Excel saves them back with quotes around them
  128. MyText = PrepText(MyText)
  129.  
  130. 'get a temporary file name
  131. FileName = GetTempFile()
  132.  
  133. 'get a free file num
  134. FileNum = FreeFile
  135.  
  136. 'open the file and stick out text to be checked into it
  137. Open FileName For Binary As #FileNum
  138.  
  139. 'put the variable into the file
  140. Put #FileNum, , MyText
  141.  
  142. 'close the file
  143. Close #FileNum
  144.  
  145. 'create the Excel application object to do the spell check for us
  146. Set xlApp = CreateObject(EXCEL_OBJECT)
  147. 'open our text file
  148. xlApp.Workbooks.OpenText FileName, xlWindows, 1, xlDelimited, xlNone, True, False, False, False, True, False, ""
  149. 'get the active sheet
  150. Set xlWorkSheet = xlApp.ActiveSheet
  151. 'get the current workbook
  152. Set xlWorkBook = xlApp.ActiveWorkbook
  153.  
  154. 'check the spelling
  155. xlWorkSheet.CheckSpelling
  156.  
  157. 'bring on the hourglass
  158. Screen.MousePointer = 11
  159.  
  160. 'get a second file name
  161. FileName2 = GetTempFile()
  162.  
  163. 'remove it from the system...
  164. Kill FileName2
  165.  
  166. '...but still use the name - save the worksheet
  167. xlWorkSheet.SaveAs FileName2, xlTextWindows
  168.  
  169. 'set the Saved property so Excel won't prompt us to save it in Excel 5.0 format
  170. xlWorkBook.Saved = True
  171.  
  172. 'quit Excel
  173. xlApp.Quit
  174.  
  175. 'get a free file number
  176. FileNum = FreeFile
  177.  
  178. 'open the file back up
  179. Open FileName2 For Binary As #FileNum
  180.  
  181. 'read the data in
  182. MyText = Input$(LOF(FileNum), #FileNum)
  183.  
  184. 'close the file up again
  185. Close #FileNum
  186.  
  187. 'get rid of the tab characters and put the commas back in
  188. MyText = FixText(MyText)
  189.  
  190. 'put the text back in the text box
  191. MyControl.Text = MyText
  192.  
  193. 'remove the object from memory
  194. Set xlApp = Nothing
  195.  
  196. 'get rid of our temporary files
  197. Kill FileName
  198. Kill FileName2
  199.  
  200. 'let user know we're done
  201. MsgBox "Spelling check is complete.", 64, ProgTitle
  202.  
  203. SpellCheck = True
  204.  
  205. SpellCheckResume:
  206. Screen.MousePointer = 0
  207. Exit Function
  208.  
  209. SpellCheckError:
  210. 'figure out what error occurred
  211. Select Case Err
  212.   Case 429
  213.     MsgBox "Unable to create OLE Automation object with Excel; make sure Excel 5.0 has been properly installed.", 16, ProgTitle
  214.   Case Else
  215.     MsgBox "Error #" + Trim$(Str$(Err)) + " - " + Error + " - has occurred.", 16, ProgTitle
  216. End Select
  217.  
  218. Resume SpellCheckResume
  219.  
  220. End Function
  221.  
  222.